home *** CD-ROM | disk | FTP | other *** search
GW-BASIC | 1985-11-20 | 24.7 KB | 691 lines |
- 10000 'SMADDEL2 - STOCK CHARTING SYSTEM INDEX FILE MAINTENANCE - RELEASE 2.1
- 10130 SCREEN 0,0,0:COLOR 7,0:WIDTH 80:DEFINT A-Z:OPTION BASE 0
- 10140 KEY OFF:FOR J=1 TO 10:KEY J,"":NEXT J:CLS:Z$=MKI$(0):C$=Z$
- 10150 H$="SMADDEL2.HS1":W$=SPACE$(80):D$=SPACE$(64)
- 10160 PD$=SPACE$(32):XD$=SPACE$(64)
- 10170 FOR K=35 TO 63 STEP 2:MID$(XD$,K,2)=MKI$(0):NEXT K
- 10180 TM=90:XM=111:DIM XN(111),XL(111),XR$(111)
- 10190 FOR J=0 TO XM:XR$(J)=XD$:NEXT J
- 10240 DIM MT(12):FOR J=1 TO 12:READ MT(J):NEXT J
- 10250 DATA 31,28,31,30,31,30,31,31,30,31,30,31
- 10260 DC$=DATE$:DY=VAL(RIGHT$(DC$,4))-1920:DM=VAL(LEFT$(DC$,2))
- 10270 DD=VAL(MID$(DC$,4,2)):MT(2)=28+ABS(DY MOD 4 = 0):J=DM:DJ=DD
- 10280 IF J>1 THEN J=J-1:DJ=DJ+MT(J):GOTO 10280
- 10290 DW=(INT((DY-1)*365.25)+DJ+5) MOD 7:IF DW=0 THEN DW=7
- 10330 DIM BS(22):FOR J=1 TO 22:READ BS(J):NEXT J
- 10340 DATA &H8B55,&HB8EC,&H0600,&H07B7,&H768B,&H8A0C,&H8B2C
- 10350 DATA &H0A76,&H0C8A,&H768B,&H8A08,&H8B34,&H0676,&H148A
- 10360 DATA &HCDFE,&HC9FE,&HCEFE,&HCAFE,&H10CD,&HCA5D,&H0008,&H0000
- 10450 DIM SC(33):FOR J=1 TO 33:READ SC(J):NEXT J
- 10460 DATA &H8B55,&H50EC,&H5153,&H5652,&HB68B,&H0010,&H2C8A,&HB68B
- 10470 DATA &H000E,&H0C8A,&HB68B,&H000C,&H348A,&HB68B,&H000A,&H148A
- 10480 DATA &HB68B,&H0008,&H3C8A,&HB68B,&H0006,&H048A,&HCDFE,&HC9FE
- 10490 DATA &HCEFE,&HCAFE,&H06B4,&H10CD,&H5A5E,&H5B59,&H5D58,&H0CCA,&H0000
- 10640 OPEN"SMSETUP2.CTL" AS #1 LEN=64:IF LOF(1)<=0 THEN 10670
- 10650 FIELD#1,64 AS B$:GET#1:IF LEFT$(B$,4)<>"SMC2" THEN 10670
- 10660 LSET D$=B$:CLOSE#1:IF MID$(D$,11,1)="Y" THEN 12830 ELSE 10740
- 10670 MID$(D$,1)="SMC2":MID$(D$,5)=MKI$(64)
- 10680 MID$(D$,7)=MKI$(1):MID$(D$,9)=MKI$(1):MID$(D$,11)="NB2"
- 10690 CLOSE#1:KILL"SMSETUP2.CTL"
- 10740 LOCATE 3,18,0:PRINT"U S E R - S U P P O R T E D S O F T W A R E";
- 10750 LOCATE 5,1
- 10760 PRINT"If you are using these programs and find";
- 10770 PRINT" them to be of value, please send $25"
- 10780 PRINT"directly to the author (Calif. residents";
- 10790 PRINT" please include appropriate sales tax)."
- 10800 PRINT"This will make you a registered owner, a";
- 10810 PRINT"nd you will be notified of later ver-"
- 10820 PRINT"sions of this and other related software";
- 10830 PRINT" as they are released. You will also"
- 10840 PRINT"receive additional printed documentation";
- 10850 PRINT" on installing and using your program."
- 10860 LOCATE 11,1
- 10870 PRINT"You are encouraged to copy and share the";
- 10880 PRINT"se programs. Suggestions and comments"
- 10890 PRINT"are welcome, and may be addressed direct";
- 10900 PRINT"ly to the author. Thank you.";
- 10910 LOCATE 14,14
- 10920 PRINT"This is an original stock charting system written by:";
- 10930 LOCATE 16,33:PRINT"Charles L. Pack";
- 10940 LOCATE 17,31:PRINT"25303 La Loma Drive";
- 10950 LOCATE 18,27:PRINT"Los Altos Hills, Ca. 94022";
- 11010 LOCATE 20,1
- 11020 PRINT"If you have not used these programs befo";
- 11030 PRINT"re, please read the Help screens as you"
- 11040 PRINT"go along. Press the letter H (for Help)";
- 11050 PRINT" to get the first directions on how to"
- 11060 PRINT"use the programs. Press the ENTER or Es";
- 11070 PRINT"c key to start running the programs.";
- 11080 H=CSRLIN:G=POS(0)
- 11110 LOCATE H,G,1:GOSUB 29650:IF ESC THEN 11240
- 11120 IF LEFT$(C$,1)=CHR$(13) THEN 11240
- 11130 IF LEFT$(C$,1)="h" OR LEFT$(C$,1)="H" THEN 11160
- 11140 GOSUB 29830:GOTO 11110
- 11160 H1=20:H2=24:G1=1:G2=80:GOSUB 29740
- 11170 MID$(W$,79)=MID$(D$,12,2):MID$(D$,12)=" "
- 11180 F=1:GOSUB 14060:MID$(D$,12)=MID$(W$,79,2)
- 11190 IF F>=0 THEN 11010 ELSE CLS:GOTO 11010
- 11230 GOSUB 29730:GOSUB 26240:IF ESC THEN 13030
- 11240 MID$(W$,79)=MID$(D$,12,2)
- 11250 CLS:PRINT"DISK DRIVE OPTIONS: (Note - programs are";
- 11260 PRINT" always on the system (default) drive).";
- 11310 LOCATE 3,1
- 11320 PRINT"A. Only one floppy disk drive is availab";
- 11330 PRINT"le (PC Jr., etc.). Data will be expec-"
- 11340 PRINT" ted on a different diskette from the ";
- 11350 PRINT"program diskette (the program will tell"
- 11360 PRINT" you which diskette it wants). Howeve";
- 11370 PRINT"r, if you are charting only a few"
- 11380 PRINT" securities, you could also select opt";
- 11390 PRINT"ion C below.";
- 11410 LOCATE 8,1
- 11420 PRINT"B. Two (or more) floppy disk drives are ";
- 11430 PRINT"available. Data and programs will be"
- 11440 PRINT" expected on separate drives, but you ";
- 11450 PRINT"can have any number of different data"
- 11460 PRINT" disks. Programs can also be on a har";
- 11470 PRINT"d disk with data on floppies. Data for"
- 11480 PRINT" a few securities can also be stored o";
- 11490 PRINT"n a program diskette; see below.";
- 11510 LOCATE 13,1
- 11520 PRINT"C: A hard disk drive is to be used. Pro";
- 11530 PRINT"grams and data are both to be on the"
- 11540 PRINT" hard disk (a separate sub-directory i";
- 11550 PRINT"s recommended). This option can also"
- 11560 PRINT" be used with a floppy diskette, with ";
- 11570 PRINT"both data and programs stored together,"
- 11580 PRINT" but data storage space will be somewh";
- 11590 PRINT"at limited.";
- 11610 LOCATE 19,1
- 11620 PRINT"THE CURRENTLY SELECTED OPTIONS ARE:";
- 11630 LOCATE 21,1
- 11640 PRINT"Disk drive option (see above): Option ";
- 11650 IF MID$(D$,12,1)=" " THEN PRINT"C.";:GOTO 11680
- 11660 IF MID$(D$,12,1)="*" THEN PRINT"A.";:GOTO 11680
- 11670 PRINT"B with data on drive ";MID$(D$,12,1);".";
- 11680 LOCATE 22,1
- 11690 PRINT"Disk operating system (IBM DOS or MS-DOS): Version ";
- 11700 PRINT MID$(D$,13,1);".";
- 11770 LOCATE 24,1
- 11780 PRINT"Are the currently selected options correct";
- 11790 GOSUB 29550:IF ESC OR YES THEN 12630
- 12030 H1=18:H2=24:G1=1:G2=80:GOSUB 29740
- 12040 LOCATE 22,1
- 12050 PRINT"WARNING: An incorrect option specificati";
- 12060 PRINT"on could cause the program to operate"
- 12070 PRINT"incorrectly or even terminate abnormally";
- 12080 PRINT", and you may have to re-start the"
- 12090 PRINT"stock charting system all over again.";
- 12110 LOCATE 20,1:PRINT"Specify disk drive option A, B or C (see above):";
- 12120 LOCATE 20,49,1:GOSUB 29660:IF NOT ESC THEN 12140
- 12130 H1=18:H2=24:G1=1:G2=80:GOSUB 29740:GOTO 11610
- 12140 IF LEFT$(C$,1)>=CHR$(96) THEN MID$(C$,1,1)=CHR$(ASC(LEFT$(C$,1))-32)
- 12150 IF LEFT$(C$,1)="C" THEN MID$(W$,77)=" ":GOTO 12350
- 12160 IF LEFT$(C$,1)="A" THEN MID$(W$,77)="*":GOTO 12350
- 12170 IF LEFT$(C$,1)<>"B" THEN GOSUB 29830:GOTO 12120
- 12210 LOCATE 20,1:PRINT SPACE$(79);
- 12220 LOCATE 20,1:PRINT"Enter drive specifier (A-Z) for data disk:";
- 12230 LOCATE 20,43,1:GOSUB 29660:IF NOT ESC THEN 12250
- 12240 H1=18:H2=24:G1=1:G2=80:GOSUB 29740:GOTO 11610
- 12250 IF LEFT$(C$,1)>=CHR$(96) THEN MID$(C$,1,1)=CHR$(ASC(LEFT$(C$,1))-32)
- 12260 IF LEFT$(C$,1)<"A" OR LEFT$(C$,1)>"Z" THEN GOSUB 29830:GOTO 12230
- 12270 MID$(W$,77)=LEFT$(C$,1)
- 12350 CLS:LOCATE 20,1:MID$(W$,78)="2"
- 12360 PRINT"Are you using IBM DOS or MS-DOS Version 1";
- 12370 GOSUB 29550:IF ESC THEN 11250
- 12380 IF YES THEN MID$(W$,78)="1"
- 12390 MID$(D$,12)=MID$(W$,77,2):GOTO 11250
- 12630 CLS:IF MID$(D$,11,1)<>"Y" THEN 12740
- 12640 IF MID$(D$,12,2)<>MID$(W$,79,2) THEN 12660
- 12650 GOSUB 25240:GOSUB 25050:GOTO 13030
- 12660 IF MID$(D$,12,1)<>"*" THEN 12740
- 12670 LOCATE 23,1:PRINT"Insert PROGRAM diskette and press ENTER.";
- 12680 GOSUB 29250:IF ESC THEN GOSUB 29830:GOTO 12680
- 12740 ON ERROR GOTO 12780
- 12750 OPEN"SMSETUP2.CTL"AS #1 LEN=64:ON ERROR GOTO 29930
- 12760 FIELD#1,64 AS B$:MID$(D$,11)="Y":LSET B$=D$
- 12770 PUT#1:CLOSE#1:GOTO 12830
- 12780 IF ERR=71 THEN RESUME 12790 ELSE 29930
- 12790 ON ERROR GOTO 29930:GOSUB 29040:GOTO 12740
- 12830 GOSUB 25240:LSET XD$=XR$(0)
- 12840 FOR J=1 TO XM:LSET XR$(J)=XD$:XN(J)=0:XL(J)=0:NEXT J
- 12850 IF MID$(D$,12,1)<>"*" THEN 12910
- 12860 LOCATE 23,1:PRINT"Insert DATA disk and press ENTER or Esc when ready.";
- 12870 GOSUB 29250:IF ESC THEN MID$(D$,11)="N":GOTO 11240
- 12910 GOSUB 26640:IF ESC THEN MID$(D$,11)="N":GOTO 11240
- 12920 ON SGN(XC)+2 GOTO 12940,12930,12990
- 12930 XF=0:XT=0:GOTO 12980
- 12940 LOCATE 23,1:PRINT"Index not found on data disk.";
- 12950 PRINT" Do you want to start a new one";
- 12960 GOSUB 29550:IF NOT YES THEN GOSUB 29140:GOTO 12910
- 12970 GOSUB 29730:XT=0:XC=0:XF=0:X4=0:X5=0:X6=0:GOSUB 26440
- 12980 X2=X1:X3=X2-1:GOSUB 15260:GOTO 13030
- 12990 XF=1:XT=XC:GOSUB 25050:X2=X1+X5-X4:X=2
- 13030 LOCATE 21,1
- 13040 PRINT"The ";CHR$(24);" ";CHR$(25);" ";CHR$(26);" ";CHR$(27);" Home ";
- 13050 PRINT"End PgUp PgDn keys are used to select a stock or a data item. ";
- 13060 PRINT"A=Add a new stock D=Delete selected stock";
- 13070 PRINT" C=Change G=Graph S=Setup Q=Quit ";
- 13080 PRINT"R=Re-insert the most recently deleted stock";
- 13090 PRINT" E=Enter volume and prices H=Help ";
- 13100 PRINT"Press appropriate key for required function.";SPACE$(35);
- 13110 GOSUB 25360
- 13120 LOCATE 24,45,1:GOSUB 29650
- 13130 IF LEFT$(C$,1)=CHR$(0) THEN 13170
- 13140 F=INSTR(1,"24681379aAcCdDeEgGhHqQrRsS",LEFT$(C$,1))
- 13150 IF F<=0 THEN GOSUB 29830:GOTO 13120
- 13160 IF F<=8 THEN 13230 ELSE 13260
- 13170 F=INSTR(1,"PKMHOQGI",RIGHT$(C$,1))
- 13180 IF F<=0 THEN GOSUB 29830:GOTO 13120
- 13230 GOSUB 25320:IF XF=0 THEN GOSUB 29850:GOTO 13110
- 13240 ON F GOSUB 24510,24140,24040,24310,24930,24740,24830,24640
- 13250 GOTO 13110
- 13260 F=(F-7)\2:IF F>8 THEN 11230
- 13270 ON F GOSUB 15260,16570,14560,13830,13830,14050,13530,15050
- 13280 ON SGN(F)+2 GOTO 13290,13030,13110
- 13290 GOSUB 25240:GOSUB 25050:GOTO 13030
- 13530 GOSUB 25320:GOSUB 29730:LOCATE 22,1
- 13540 PRINT"Do you want to quit the stock charting system and go to DOS";
- 13550 GOSUB 29550:IF ESC OR NOT YES THEN F=0:RETURN
- 13560 GOSUB 29730:GOSUB 26240:IF ESC THEN F=0:RETURN
- 13570 IF MID$(D$,12,1)<>"*" THEN 13610
- 13580 LOCATE 23,1:PRINT"Insert PROGRAM diskette and press ENTER.";
- 13590 GOSUB 29250:IF ESC THEN F=0:RETURN
- 13610 MID$(D$,11)="N":ON ERROR GOTO 13640
- 13620 OPEN"SMSETUP2.CTL" AS #1 LEN=64:ON ERROR GOTO 29930
- 13630 FIELD#1,64 AS B$:LSET B$=D$:PUT#1:CLOSE#1:GOTO 13660
- 13640 IF ERR=71 THEN RESUME 13650 ELSE 29930
- 13650 GOSUB 29040:IF ESC THEN F=0:RETURN ELSE 13610
- 13660 IF MID$(D$,12,1)<>"*" THEN 13690
- 13670 LOCATE 23,1:PRINT"Insert diskette with DOS on it and press ENTER.";
- 13680 GOSUB 29250
- 13690 CLS:SYSTEM
- 13830 GOSUB 25320:GOSUB 29730:LOCATE 22,1
- 13840 PRINT"Do you want to draw a graph or enter volume and prices";
- 13850 GOSUB 29550:IF ESC OR NOT YES THEN F=0:RETURN
- 13860 GOSUB 29730:GOSUB 26240:IF ESC THEN F=0:RETURN
- 13870 IF MID$(D$,12,1)<>"*" THEN 13960
- 13880 LOCATE 23,1:PRINT"Insert PROGRAM diskette and press ENTER.";
- 13890 GOSUB 29250:IF ESC THEN F=0:RETURN
- 13960 LOCATE 23,1:PRINT"One moment please, loading program ... ";
- 13970 ON ERROR GOTO 13980:RUN"SMENTRY2"
- 13980 IF ERR=53 OR ERR=71 THEN RESUME 13990 ELSE 29930
- 13990 GOSUB 29040:GOTO 13960
- 14050 GOSUB 25320:LSET H$="SMADDEL2.HS2"
- 14060 GOSUB 29730:IF MID$(D$,12,1)<>"*" THEN 14110
- 14070 LOCATE 24,1:PRINT"Insert PROGRAM diskette and press ENTER,";
- 14080 PRINT" or press Esc to cancel Help screens.";
- 14090 GOSUB 29250:IF ESC THEN F=0:RETURN
- 14110 ON ERROR GOTO 14310:OPEN H$ FOR INPUT AS #1
- 14120 ON ERROR GOTO 29930:CLS:L=0
- 14130 IF EOF(1) THEN 14270
- 14140 LINE INPUT#1,B$:L=L+1:IF L<24 THEN PRINT B$:GOTO 14130
- 14150 PRINT"Press ENTER to see next Help screen, or E";
- 14160 PRINT"sc to cancel Help screen display.";
- 14170 GOSUB 29250:IF NOT ESC THEN CLS:L=1:PRINT B$:GOTO 14130
- 14180 CLOSE#1:F=-1:IF MID$(D$,12,1)<>"*" THEN RETURN
- 14190 CLS:LOCATE 24,1:PRINT"Insert DATA diskette";
- 14200 PRINT" and press ENTER or Esc key.";:GOSUB 29250:RETURN
- 14270 CLOSE#1:F=-1:LOCATE 24,1:IF MID$(D$,12,1)<>"*" THEN 14290
- 14280 PRINT"Insert DATA diskette. ";
- 14290 GOSUB 29240:RETURN
- 14310 IF ERR=53 THEN RESUME 14340
- 14320 IF ERR=71 THEN RESUME 14330 ELSE 29930
- 14330 GOSUB 29040:IF ESC THEN F=0:RETURN ELSE 14110
- 14340 LOCATE 25,1:COLOR 23,0:PRINT"Help screen not available.";
- 14350 COLOR 7,0:BEEP:OK=0:F=0:LOCATE 23,1
- 14360 IF MID$(D$,12,1)<>"*" THEN RETURN
- 14370 PRINT"Insert PROGRAM diskette and press ENTER to try again,"
- 14380 PRINT"or insert DATA diskette and press Esc to cancel Help.";
- 14390 GOSUB 29250:IF ESC THEN RETURN ELSE 14110
- 14560 IF X5>0 OR X2<=X3 THEN 14590
- 14570 LOCATE 25,1:COLOR 23,0:PRINT"Can only Add or Re-Insert here.";
- 14580 COLOR 7,0:BEEP:OK=0:RETURN
- 14590 GOSUB 29730:LOCATE 21,1
- 14600 PRINT"WARNING - you are about to delete ALL pr";
- 14610 PRINT"ice history and other data for the"
- 14620 PRINT"security indicated by the selector block";
- 14630 PRINT". (Data can be Restored for only the"
- 14640 PRINT"most recently deleted security, and only";
- 14650 PRINT" if the add/delete program has not been"
- 14660 PRINT"terminated.) Verify if you wish to dele";
- 14670 PRINT"te this security";
- 14680 GOSUB 29550:IF ESC OR NOT YES THEN GOSUB 25320:F=0:RETURN
- 14690 GOSUB 29730:GOSUB 26240:XE=X5:IF XN(XF)<>XF THEN 14730
- 14710 XN(XE)=0:XL(XE)=0:X3=X2-1:X5=0:XF=0:XC=0
- 14720 LSET XD$=XR$(0):GOSUB 25180:GOTO 15260
- 14730 XN(XL(X5))=XN(X5):XL(XN(X5))=XL(X5):IF X4=XF THEN 14760
- 14740 IF XN(X6)=XF OR X3-X2>=X2-X1 THEN 14940
- 14750 IF X5=X6 THEN 14790 ELSE X5=XN(X5):GOTO 14810
- 14760 IF X5=XF THEN XF=XN(XF):X4=XF:X5=XF:GOTO 14810
- 14770 IF XN(X5)<>XF THEN IF X5=X6 THEN 14790 ELSE X5=XN(X5):GOTO 14810
- 14780 LSET XD$=XR$(0):GOSUB 25180:X5=XL(X5):X6=X5:X3=X3-1:X2=X3:GOTO 14990
- 14790 X5=XN(X5):X6=X5:LSET XD$=XR$(X6):Y=X3:GOSUB 25180:GOTO 14990
- 14810 H1=X2:H2=X3:G1=1:G2=80:Z=0:L=1
- 14820 SC(27)=&H6B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
- 14830 IF XN(X6)=XF THEN X3=X3-1:GOTO 14990
- 14840 X6=XN(X6):LSET XD$=XR$(X6):Y=X3:GOSUB 25180:GOTO 14990
- 14940 IF X4=X5 THEN 14980
- 14950 H1=X1:H2=X2:G1=1:G2=80:Z=0:L=1
- 14960 SC(27)=&H7B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
- 14970 IF X5=X6 THEN X6=XL(X6)
- 14980 X5=XL(X5):X4=XL(X4):LSET XD$=XR$(X4):Y=X1:GOSUB 25180
- 14990 XN(XE)=0:XL(XE)=0:XC=XC-1:F=0:RETURN
- 15050 IF XE>0 THEN 15080
- 15060 LOCATE 25,1:COLOR 23,0:PRINT"No Deleted entry to Re-insert.";
- 15070 COLOR 7,0:BEEP:OK=0:RETURN
- 15080 GOSUB 25320:IF XF<=0 OR X2=19 OR (X2>X3 AND X5=0) THEN 15180
- 15160 H1=X2:H2=19:G1=1:G2=80:Z=0:L=1
- 15170 SC(27)=&H7B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
- 15180 XA=XE:XE=0:LSET XD$=XR$(XA):GOSUB 25180
- 15190 GOSUB 16370:XC=XC+1:GOSUB 26440:RETURN
- 15260 XA=0:IF XT<XM THEN XA=XT+1:GOSUB 25320:GOTO 15310
- 15270 FOR J=1 TO XM:IF XN(J)<=0 AND XL(J)<=0 AND J<>XE THEN XA=J:J=XM
- 15280 NEXT J:IF XA>0 THEN GOSUB 25320:GOTO 15310
- 15290 LOCATE 25,1:COLOR 23,0:PRINT"Sorry, index is full!";
- 15300 COLOR 7,0:BEEP:OK=0:RETURN
- 15310 LSET XD$=XR$(0):IF XF<=0 OR (X2>X3 AND X5=0) THEN 15350
- 15320 IF X2=19 THEN GOSUB 25180:GOTO 15350
- 15330 H1=X2:H2=19:G1=1:G2=80:Z=0:L=1
- 15340 SC(27)=&H7B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
- 15350 X=1:GOSUB 25370:GOSUB 16930:IF ESC OR L<=0 THEN 15550
- 15360 X=4:GOSUB 25370:MID$(XD$,34)="+":GOSUB 17540
- 15370 MID$(XD$,34)=" ":IF ESC THEN 15550
- 15380 X=2:GOSUB 25370:GOSUB 17060:IF ESC THEN 15550
- 15390 X=3:GOSUB 25370:GOSUB 17430:IF ESC THEN 15550
- 15400 X=5:GOSUB 25370:GOSUB 17830:IF ESC THEN 15550
- 15410 X=6:GOSUB 25370:GOSUB 17930:IF ESC THEN 15550
- 15420 X=7:GOSUB 25370:GOSUB 18030:IF ESC THEN 15550
- 15430 X=8:GOSUB 25370:GOSUB 18330:IF ESC THEN 15550
- 15440 LSET XR$(XA)=XD$:XC=XC+1:IF XA=XT+1 THEN XT=XA
- 15450 GOSUB 16370:IF TC=0 THEN 15470
- 15460 GOSUB 27110:IF TC=0 THEN MID$(XR$(XA),35,2)=MKI$(0):X=4:GOSUB 25320
- 15470 GOSUB 26440:X=1:F=0:RETURN
- 15550 IF XF<=0 OR (X2>X3 AND X5=0) THEN LSET XD$=XR$(0):GOTO 15590
- 15560 H1=X2:H2=19:G1=1:G2=80:Z=0:L=1:IF H1=H2 THEN 15580
- 15570 SC(27)=&H6B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
- 15580 Y=X3:LSET XD$=XR$(X6)
- 15590 GOSUB 25180:X=2:F=0:RETURN
- 16370 IF XF>0 THEN 16420
- 16390 XF=XA:XN(XA)=XA:XL(XA)=XA:X4=XA:X6=XA:X5=XA:X2=X1:X3=X1:RETURN
- 16420 IF X2=X1 AND X5=XF THEN XF=XA:GOTO 16450
- 16430 IF X2>X3 AND X5=0 THEN 16480
- 16450 XN(XA)=X5:XL(XA)=XL(X5):XN(XL(X5))=XA:XL(X5)=XA:IF X4=X5 THEN X4=XA
- 16460 X5=XA:IF X3>=19 THEN X6=XL(X6):RETURN ELSE X3=X3+1:RETURN
- 16480 XN(XA)=XF:XL(XA)=XL(XF):XN(XL(XF))=XA:XL(XF)=XA
- 16490 X6=XA:X5=XA:X3=X2:RETURN
- 16570 IF X5>0 OR X2<=X3 THEN 16610
- 16580 LOCATE 25,1:COLOR 23,0:PRINT"Can only Add or Re-insert here.";
- 16590 COLOR 7,0:BEEP:OK=0:RETURN
- 16610 ON X GOSUB 16930,17060,17430,17540,17830,17930,18030,18330
- 16620 IF ESC THEN F=0:RETURN ELSE IF X<>2 THEN 16650
- 16630 IF RIGHT$(W$,4)<>".SMP" THEN F=0:RETURN
- 16640 TC=CVI(MID$(XD$,35,2)):IF TC<>0 THEN 16660
- 16650 LSET XR$(X5)=XD$:F=0:RETURN
- 16660 GOSUB 29730:J=1:MID$(W$,1)=SPACE$(14)
- 16670 K=LEN(W$)-4-L:MID$(W$,K)="D":IF TC>0 THEN MID$(W$,K)="W"
- 16680 IF MID$(D$,12,1)<"A" THEN 16710
- 16690 K=K-2:MID$(W$,K)=MID$(D$,12,1):MID$(W$,K+1)=":"
- 16700 MID$(W$,1)=MID$(D$,12,1):MID$(W$,2)=":":J=J+2
- 16710 L=J:J=29:MID$(W$,L)="D":IF TC>0 THEN MID$(W$,L)="W":L=L+1 ELSE L=L+1
- 16720 IF MID$(XR$(X5),J,1)=" " THEN J=J+1:GOTO 16720
- 16730 MID$(W$,L)=MID$(XR$(X5),J,35-J):L=L+35-J:MID$(W$,L)=".SMP":L=L+3
- 16790 ON ERROR GOTO 16820
- 16800 NAME LEFT$(W$,L) AS RIGHT$(W$,LEN(W$)-K+1)
- 16810 ON ERROR GOTO 29930:GOTO 16890
- 16820 IF ERR=53 THEN RESUME 16860
- 16830 IF ERR=58 THEN RESUME 16890
- 16840 IF ERR=71 THEN RESUME 16850 ELSE 29930
- 16850 GOSUB 29140:GOTO 16790
- 16860 LOCATE 25,1:COLOR 23,0:PRINT"Price history file not found.";
- 16870 COLOR 7,0:BEEP:OK=0:MID$(XD$,35,2)=MKI$(0):X=4:GOSUB 25320:X=2
- 16880 MID$(XR$(X5),35,2)=MKI$(0):GOSUB 26440:F=0:RETURN
- 16890 LSET XR$(X5)=XD$:GOSUB 26440:F=0:RETURN
- 16930 GOSUB 29730:LOCATE 21,1
- 16940 PRINT"Enter the name of the stock (or other security):";
- 16950 Q=24:GOSUB 28810:IF ESC OR L<=0 THEN 16990
- 16960 MID$(XD$,5)=SPACE$(24):MID$(XD$,5)=LEFT$(W$,L)
- 16990 GOSUB 25320:RETURN
- 17060 GOSUB 29730:LOCATE 21,1:MID$(W$,LEN(W$)-9)=SPACE$(10)
- 17070 PRINT"Only a hyphen (-), underline (_) or plus";
- 17080 PRINT" sign (+) and the letters A through Z"
- 17090 PRINT"and digits 0 through 9 are allowed in th";
- 17100 PRINT"e ticker symbol; and the first charac-"
- 17110 PRINT"ter must be a letter A-Z. Valid example";
- 17120 PRINT"s include: T, PZL_B, IBM+P, AGREA."
- 17130 PRINT"Enter the symbol here:";
- 17140 LOCATE 24,23:Q=6:GOSUB 28810
- 17150 IF ESC THEN GOSUB 25320:RETURN ELSE IF L>0 THEN 17180
- 17160 IF MID$(XD$,29,6)<>" " THEN GOSUB 25320:RETURN
- 17170 GOSUB 29870:GOSUB 28830:GOTO 17150
- 17180 IF MID$(W$,L,1)=" " THEN G=G-1:L=L-1:P=P-1:GOTO 17180 ELSE K=L
- 17190 IF MID$(W$,K,1)>="A" AND MID$(W$,K,1)<="Z" THEN 17230
- 17200 IF K=1 THEN 17360 ELSE IF MID$(W$,K,1)="+" THEN 17230
- 17210 IF MID$(W$,K,1)="-" OR MID$(W$,K,1)="_" THEN 17230
- 17220 IF MID$(W$,K,1)<"0" OR MID$(W$,K,1)>"9" THEN 17360
- 17230 IF K>1 THEN K=K-1:GOTO 17190
- 17240 MID$(W$,LEN(W$)-9)=" .SMP":MID$(W$,LEN(W$)-3-L)=LEFT$(W$,L)
- 17250 FOR J=1 TO XT
- 17260 IF MID$(W$,LEN(W$)-9,6)<>MID$(XR$(J),29,6) THEN 17300
- 17270 IF XN(J)=0 AND XL(J)=0 AND J<>XE THEN 17300
- 17280 T=CVI(MID$(XR$(J),35,2)):IF T=0 THEN J=XT+2:GOTO 17300
- 17290 IF SGN(T)=SGN(TC) THEN J=XT+2
- 17300 NEXT J:IF J>XT+1 THEN MID$(W$,LEN(W$)-9)=SPACE$(10):GOTO 17380
- 17310 MID$(XD$,29)=MID$(W$,LEN(W$)-9,6):GOSUB 25320:RETURN
- 17360 LOCATE 25,1:COLOR 23,0:PRINT"Invalid characters in ticker symbol.";
- 17370 COLOR 7,0:BEEP:OK=0:GOSUB 28830:GOTO 17150
- 17380 LOCATE 25,1:COLOR 23,0:PRINT"This ticker symbol already exists.";
- 17390 COLOR 7,0:BEEP:OK=0:GOSUB 28830:GOTO 17150
- 17430 GOSUB 29730:LOCATE 21,1
- 17440 PRINT"Enter the exchange (NYSE, AMEX, OTC, etc.):";
- 17450 Q=4:GOSUB 28810
- 17460 IF ESC THEN GOSUB 25320:RETURN ELSE IF L>0 THEN 17490
- 17470 IF MID$(XD$,1,1)>" " THEN GOSUB 25320:RETURN
- 17480 GOSUB 29870:GOSUB 28830:GOTO 17460
- 17490 MID$(XD$,1)=SPACE$(4):MID$(XD$,1)=LEFT$(W$,L):GOSUB 25320:RETURN
- 17540 GOSUB 29730:LOCATE 21,1
- 17550 PRINT"Do you want to enter prices daily, for this stock only"
- 17560 PRINT"If not, the program assumes you want to enter data weekly."
- 17570 PRINT"Warning: Once entered, this parameter cannot be changed!";
- 17580 LOCATE 21,55:GOSUB 29550:IF ESC THEN RETURN
- 17590 H1=21:H2=22:G1=1:G2=80:GOSUB 29740:LOCATE 21,1
- 17610 PRINT"Prices can be kept for at least 5, but n";
- 17620 PRINT"ot more than";TM;"days (weekends are not"
- 17630 PRINT"counted) or weeks. For how many periods";
- 17640 PRINT" do you want price data?";
- 17650 LOCATE 22,65:R=0:WL!=5:WH!=CSNG(TM):GOSUB 28460:IF ESC THEN RETURN
- 17660 IF L<=0 THEN GOSUB 29870:GOTO 17650
- 17670 TC=CINT(W!):IF YES THEN TC=-(TC)
- 17680 MID$(XD$,35,2)=MKI$(TC):GOSUB 25620
- 17690 RETURN
- 17830 GOSUB 29730:LOCATE 21,1
- 17840 PRINT"Enter the annual earnings per share (or other unit):";
- 17850 R=1:WL!=-49.99:WH!=49.99:GOSUB 28460
- 17860 IF NOT ESC AND L>0 THEN MID$(XD$,41)=MKI$(CINT(W!*100))
- 17890 GOSUB 25320:RETURN
- 17930 GOSUB 29730:LOCATE 21,1
- 17940 PRINT"Enter the annual dividend or interest per unit:";
- 17950 R=1:WL!=0:WH!=49.99:GOSUB 28460
- 17960 IF NOT ESC AND L>0 THEN MID$(XD$,39)=MKI$(CINT(W!*100))
- 17990 GOSUB 25320:RETURN
- 18030 GOSUB 29730:MID$(W$,LEN(W$)-3)=MID$(XD$,45,4):LOCATE 21,1
- 18040 PRINT"What are the low and high estimates for ";
- 18050 PRINT"the 3-5 year price goal for this stock?"
- 18060 PRINT"Each estimate is to be entered separatel";
- 18070 PRINT"y as a whole number between 0 and 999."
- 18080 PRINT"Enter zero where either or both of the p";
- 18090 PRINT"rice goals are not known or don't apply.";
- 18110 LOCATE 24,1:PRINT"Enter the LOWEST estimate first:";
- 18120 R=0:WL!=0:WH!=999:GOSUB 28460:IF ESC THEN 18270 ELSE IF L<=0 THEN 18210
- 18130 MID$(XD$,45,2)=MKI$(CINT(W!*32))
- 18140 IF CINT(W!*32)>CVI(MID$(XD$,47,2)) THEN MID$(XD$,47)=MID$(XD$,45,2)
- 18150 GOSUB 25370
- 18210 LOCATE 24,1:PRINT"Enter the HIGHEST estimate next:";
- 18220 R=0:WL!=0:WH!=999:GOSUB 28460:IF ESC THEN 18270
- 18230 IF L>0 THEN MID$(XD$,47,2)=MKI$(CINT(W!*32))
- 18240 WL!=CSNG(CVI(MID$(XD$,45,2))):WH!=CSNG(CVI(MID$(XD$,47,2)))
- 18250 IF WL!<=WH! THEN GOSUB 25320:RETURN ELSE GOSUB 25370:GOTO 18280
- 18270 MID$(XD$,45)=RIGHT$(W$,4):GOSUB 25320:RETURN
- 18280 LOCATE 25,1:COLOR 23,0:PRINT"Low exceeds high value, try again.";
- 18290 COLOR 7,0:OK=0:BEEP:GOTO 18110
- 18330 GOSUB 29730:LOCATE 21,1
- 18340 PRINT"Enter the stop (or other) limit price:";
- 18350 R=1:WL!=-999.9:WH!=999.9:GOSUB 28460
- 18360 IF NOT ESC AND L>0 THEN MID$(XD$,43)=MKI$(CINT(W!*32))
- 18390 GOSUB 25320:RETURN
- 24040 IF X<1 OR X>=8 THEN GOSUB 29850:GOTO 24090
- 24050 IF X<>3 THEN X=X+1 ELSE X=5
- 24090 RETURN
- 24140 IF X<=1 OR X>8 THEN GOSUB 29850:GOTO 24190
- 24150 IF X<>5 THEN X=X-1 ELSE X=3
- 24190 RETURN
- 24310 IF X2>X1 AND X2<=X3 THEN X2=X2-1:X5=XL(X5):RETURN
- 24320 IF X2=X3+1 THEN X5=X6:IF X4=XF THEN X2=X3:RETURN ELSE 24350
- 24330 IF X2=X1 AND X4<>XF THEN 24360 ELSE GOSUB 29850:RETURN
- 24350 X3=X3+1:X4=XL(X4):GOTO 24370
- 24360 X4=XL(X4):X5=X4:X6=XL(X6)
- 24370 H1=X1:H2=X3:G1=1:G2=80:Z=0:L=1
- 24380 SC(27)=&H7B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
- 24390 LSET XD$=XR$(X4):Y=X1:GOSUB 25180:RETURN
- 24510 IF X2>=X1 AND X2<X3 THEN X2=X2+1:X5=XN(X5):RETURN
- 24520 IF X2<>X3 THEN GOSUB 29850:RETURN
- 24530 IF X3<19 THEN X5=0:X2=X2+1:RETURN
- 24560 H1=X1:H2=X3:G1=1:G2=80:Z=0:L=1
- 24570 SC(27)=&H6B4:DEF SEG:AD=VARPTR(SC(1)):CALL AD(H1,G1,H2,G2,Z,L)
- 24580 X4=XN(X4):IF XN(X5)=XF THEN X5=0:X3=X3-1:RETURN
- 24590 X6=XN(X6):X5=X6:LSET XD$=XR$(X5):Y=X2:GOSUB 25180:RETURN
- 24640 J=0:IF X4=XF THEN 24680
- 24650 X4=XL(X4):J=J+1:IF J<10 AND X4<>XF THEN 24650
- 24660 GOSUB 25050:GOTO 24690
- 24680 IF X2<=X1 THEN GOSUB 29850:RETURN
- 24690 X5=X4:X2=X1:RETURN
- 24740 J=0:IF XN(X6)=XF THEN 24780
- 24750 X6=XN(X6):X4=XN(X4):J=J+1:IF J<10 AND X6<>XL(XF) THEN 24750
- 24760 GOSUB 25050:GOTO 24790
- 24780 IF X2>=X3 THEN GOSUB 29850:RETURN
- 24790 X5=X6:X2=X3:RETURN
- 24830 IF X4=XF THEN 24880
- 24840 X4=XF:GOSUB 25050:GOTO 24890
- 24880 IF X5=XF AND X2=X1 THEN GOSUB 29850:RETURN
- 24890 X5=XF:X2=X1:RETURN
- 24930 IF XN(X6)=XF THEN 24980
- 24940 X4=XL(XF):X2=X1
- 24950 IF X4=XF OR X2>=19 THEN GOSUB 25050:GOTO 24990
- 24960 X4=XL(X4):X2=X2+1:GOTO 24950
- 24980 IF X5<=0 OR XN(X5)=XF THEN GOSUB 29850:RETURN
- 24990 X5=XL(XF):X2=X3:RETURN
- 25050 X3=X1:X6=X4:IF XF<=0 THEN 25090
- 25060 LSET XD$=XR$(X6):Y=X3:GOSUB 25180
- 25070 IF XN(X6)=XF OR X3>=19 THEN 25090
- 25080 X6=XN(X6):X3=X3+1:GOTO 25060
- 25090 RETURN
- 25180 GOSUB 25420:GOSUB 25470:GOSUB 25520:GOSUB 25620
- 25190 GOSUB 25720:GOSUB 25770:GOSUB 25820:GOSUB 25920:RETURN
- 25240 CLS:X1=0
- 25250 X1=X1+1:PRINT" ADD/DELETE STOCKS - VERSION 2.1";
- 25260 LOCATE X1,42:PRINT" NO. OF ANNUAL 3-5 YR. STOP"
- 25270 X1=X1+1:PRINT" NAME OF STOCK SYMBOL(EXCH)";
- 25280 LOCATE X1,42:PRINT"DAYS/WKS EARNS. DIVID. PR.GOAL LIMIT";
- 25290 X1=X1+2:RETURN
- 25320 ON X GOTO 25420,25470,25520,25620,25720,25770,25820,25920
- 25360 Y=X2:LSET XD$=XR$(X5)
- 25370 COLOR 0,7
- 25380 ON X GOSUB 25420,25470,25520,25620,25720,25770,25820,25920
- 25390 COLOR 7,0:RETURN
- 25420 LOCATE Y,1:PRINT" ";MID$(XD$,5,24);" ";:RETURN
- 25470 LOCATE Y,26:PRINT" ";MID$(XD$,29,6);" ";:RETURN
- 25520 LOCATE Y,33:L=1:IF MID$(XD$,1,1)=" " THEN PRINT SPACE$(8);:RETURN
- 25530 L=L+1:IF L<=4 AND MID$(XD$,L,1)<>" " THEN 25530
- 25540 PRINT" (";MID$(XD$,1,L-1);")";SPACE$(6-L);:RETURN
- 25620 LOCATE Y,41:IF MID$(XD$,34,1)<=" " THEN PRINT SPACE$(10);:RETURN
- 25630 TC=CVI(MID$(XD$,35,2)):IF TC=0 THEN PRINT" NONE ";:RETURN
- 25640 PRINT USING"###";ABS(TC);
- 25650 IF TC<0 THEN PRINT" DAYS ";:RETURN ELSE PRINT" WEEKS ";:RETURN
- 25720 LOCATE Y,51:IF MID$(XD$,34,1)<=" " THEN PRINT SPACE$(7);:RETURN
- 25730 PRINT USING"###.## ";CSNG(CVI(MID$(XD$,41,2)))/100;:RETURN
- 25770 LOCATE Y,58:IF MID$(XD$,34,1)<=" " THEN PRINT SPACE$(7);:RETURN
- 25780 PRINT USING"###.## ";CSNG(CVI(MID$(XD$,39,2)))/100;:RETURN
- 25820 LOCATE Y,65:IF MID$(XD$,34,1)<=" " THEN PRINT SPACE$(9);:RETURN
- 25830 W=CINT(CSNG(CVI(MID$(XD$,45,2)))/32)
- 25840 PRINT USING"####";W;:MID$(W$,1)=SPACE$(5)
- 25850 W=CINT(CSNG(CVI(MID$(XD$,47,2)))/32)
- 25860 MID$(W$,1)=STR$(W):MID$(W$,1)="-"
- 25870 PRINT LEFT$(W$,5);:RETURN
- 25920 LOCATE Y,74:IF MID$(XD$,34,1)<=" " THEN 25990
- 25930 W!=CSNG(CVI(MID$(XD$,43,2)))/32
- 25940 IF ABS(W!)<9.9995 THEN PRINT USING"##.### ";W!;:RETURN
- 25950 IF ABS(W!)<99.995 THEN PRINT USING"###.## ";W!;:RETURN
- 25960 IF ABS(W!)<999.95 THEN PRINT USING"####.# ";W!;:RETURN
- 25990 PRINT SPACE$(7);:RETURN
- 26240 IF XE<=0 THEN 26440
- 26250 TC=CVI(MID$(XR$(XE),35,2)):IF TC=0 THEN 26440
- 26260 MID$(W$,1)=SPACE$(14):L=1
- 26270 IF MID$(D$,12,1)>="A" THEN MID$(W$,1)=MID$(D$,12,1):MID$(W$,2)=":":L=3
- 26280 K=29:MID$(W$,L)="D":L=L+1:IF TC>0 THEN MID$(W$,L-1)="W"
- 26290 IF MID$(XR$(XE),K,1)=" " THEN K=K+1:GOTO 26290
- 26300 MID$(W$,L)=MID$(XR$(XE),K,35-K):L=L+35-K:MID$(W$,L)=".SMP":L=L+3
- 26340 ON ERROR GOTO 26360
- 26350 KILL LEFT$(W$,L):GOTO 26380
- 26360 IF ERR=71 THEN RESUME 26390
- 26370 IF ERR=53 THEN RESUME 26380 ELSE 29930
- 26380 ON ERROR GOTO 29930:XE=0:GOTO 26440
- 26390 GOSUB 29140:GOTO 26340
- 26440 GOSUB 26830:IF ESC THEN 26440
- 26450 MID$(XD$,1,4)="SMX2":MID$(XD$,5,2)=MKI$(64)
- 26460 MID$(XD$,7,2)=MKI$(XM):MID$(XD$,9,2)=MKI$(XC)
- 26470 FOR K=11 TO 63 STEP 2:MID$(XD$,K,2)=MKI$(0):NEXT K:K=0
- 26480 LSET XB$=XD$:PUT#2:XP=XF:IF XP<=0 THEN 26580
- 26490 H1=X4:H2=X5:IF X5>0 OR X2<=X3 THEN 26510
- 26500 H2=X6:IF X4<>XF THEN H1=XL(X4)
- 26510 LSET XB$=XR$(XP):PUT#2:K=K+1
- 26520 IF XP=H1 THEN MID$(XD$,11,2)=MKI$(K)
- 26530 IF XP=H2 THEN MID$(XD$,13,2)=MKI$(K)
- 26540 XP=XN(XP):IF XP<>XF THEN 26510
- 26550 LSET XB$=XD$:PUT#2,1:LSET XD$=XR$(X5):GOTO 26590
- 26580 LSET XB$=XR$(0):FOR J=1 TO XM:PUT#2:NEXT J
- 26590 CLOSE#2:RETURN
- 26640 GOSUB 26830:IF ESC THEN RETURN
- 26650 IF LOF(2)<=0 THEN XC=-1:CLOSE#2:KILL LEFT$(W$,L):RETURN
- 26660 GET#2:V2=0:IF MID$(XB$,1,4)="SMX2" THEN V2=-1:GOTO 26710
- 26670 XC=CVI(MID$(XB$,3,2)):IF XC>0 THEN X4=1:X5=1:GOTO 26740
- 26680 X4=0:X5=0:CLOSE#2:RETURN
- 26710 XC=CVI(MID$(XB$,9,2))
- 26720 X4=CVI(MID$(XB$,11,2)):X5=CVI(MID$(XB$,13,2))
- 26730 IF XC<=0 THEN CLOSE#2:RETURN
- 26740 FOR J=1 TO XC
- 26750 GET#2:LSET XR$(J)=XB$:XN(J)=J+1:XL(J)=J-1:IF V2 THEN 26790
- 26760 W!=CVS(MID$(XB$,37,4)):MID$(XR$(J),39)=MKI$(CINT(W!*100))
- 26770 W!=CVS(MID$(XB$,41,4)):MID$(XR$(J),41)=MKI$(CINT(W!*100))
- 26780 MID$(XR$(J),37)=MKI$(0):MID$(XR$(J),43)=MKI$(0)
- 26790 NEXT J:XN(XC)=1:XL(1)=XC:CLOSE#2:RETURN
- 26830 MID$(W$,1)=SPACE$(80):L=1:IF MID$(D$,12,1)<"A" THEN 26850
- 26840 MID$(W$,1)=MID$(D$,12,1):MID$(W$,2)=":":L=3
- 26850 MID$(W$,L)="INDEXFIL.SMX":L=L+11:ESC=0
- 26950 ON ERROR GOTO 26980
- 26960 OPEN LEFT$(W$,L) AS #2 LEN=64:ON ERROR GOTO 29930
- 26970 FIELD#2,64 AS XB$:RETURN
- 26980 IF ERR=71 THEN RESUME 26990 ELSE 29930
- 26990 GOSUB 29140:IF ESC THEN RETURN ELSE 26950
- 27110 IF TC=0 THEN RETURN
- 27120 BJ=DJ:BY=DY:BW=DW:IF TC>1 THEN 27210
- 27130 IF BW>5 THEN BJ=BJ-BW+5:GOTO 27150
- 27140 IF BW=1 THEN BJ=BJ-3 ELSE BJ=BJ-1
- 27150 BJ=BJ-(ABS(TC)\5)*7-(ABS(TC) MOD 5)
- 27160 IF BJ<=0 THEN BY=BY-1:BJ=BJ+365+ABS(BY MOD 4 = 0):GOTO 27160
- 27170 BW=(INT((BY-1)*365.25)+BJ+5) MOD 7:IF BW=0 THEN BW=7
- 27180 IF BW<=5 THEN 27240 ELSE BJ=BJ-BW+5:BW=5
- 27190 IF BJ<=0 THEN BY=BY-1:BJ=BJ+365+ABS(BY MOD 4 = 0)
- 27200 GOTO 27240
- 27210 IF BW>5 THEN BJ=BJ-BW+5 ELSE BJ=BJ-BW-2
- 27220 BW=5:BJ=BJ-TC*7
- 27230 IF BJ<=0 THEN BY=BY-1:BJ=BJ+365+ABS(BY MOD 4 = 0):GOTO 27230
- 27240 MID$(W$,1)=SPACE$(14):L=1
- 27250 IF MID$(D$,12,1)>="A" THEN MID$(W$,1)=MID$(D$,12,1):MID$(W$,2)=":":L=3
- 27260 K=29:MID$(W$,L)="D":L=L+1:IF TC>0 THEN MID$(W$,L-1)="W"
- 27270 IF MID$(XD$,K,1)=" " THEN K=K+1:GOTO 27270
- 27280 MID$(W$,L)=MID$(XD$,K,35-K):L=L+35-K:MID$(W$,L)=".SMP":L=L+3
- 27310 GOSUB 29730:LOCATE 21,1
- 27320 PRINT"Initializing volume and price data, one moment please ...";
- 27330 J=0:ON ERROR GOTO 27470
- 27340 OPEN LEFT$(W$,L) AS #3 LEN=32:FIELD#3,32 AS PB$
- 27350 MID$(PD$,1)="SMP2":MID$(PD$,5)=MKI$(32):MID$(PD$,7)=MKI$(ABS(TC))
- 27360 MID$(PD$,9)=MKI$(ABS(TC)):IF TC<0 THEN TN=1 ELSE TN=7
- 27370 MID$(PD$,11)=MKI$(TN):MID$(PD$,13)=MKI$(ABS(TC))
- 27380 FOR K=15 TO 31 STEP 2:MID$(PD$,K)=MKI$(0):NEXT K:LSET PB$=PD$:PUT#3
- 27390 FOR K=5 TO 15 STEP 2:MID$(PD$,K)=MKI$(0):NEXT K
- 27400 EJ=BJ:EY=BY:EW=BW:T=365+ABS(EY MOD 4 = 0)
- 27410 FOR J=1 TO ABS(TC)
- 27420 EJ=EJ+TN:IF TN<>1 THEN 27440
- 27430 EW=EW+1:IF EW>5 THEN EJ=EJ+2:EW=1
- 27440 IF EJ>T THEN EJ=EJ-T:EY=EY+1:T=365+ABS(EY MOD 4 = 0)
- 27450 MID$(PD$,1)=MKS$(CSNG(EY*1000+EJ)):LSET PB$=PD$:PUT#3
- 27460 NEXT J:CLOSE#3:ON ERROR GOTO 29930:RETURN
- 27470 IF ERR=71 THEN RESUME 27580
- 27480 IF ERR=67 THEN RESUME 27520
- 27490 IF ERR=61 THEN RESUME 27510 ELSE 29930
- 27510 LOCATE 21,1:PRINT"The data disk has no more space!";:GOTO 27530
- 27520 LOCATE 21,1:PRINT"The data disk directory is full!";
- 27530 PRINT" In order to add another stock, it"
- 27540 PRINT"will be necessary to either delete an ex";
- 27550 PRINT"isting stock or start a new data disk.";
- 27560 IF J>0 THEN CLOSE#3:KILL LEFT$(W$,L)
- 27570 TC=0:GOSUB 29230:RETURN
- 27580 IF J>0 THEN CLOSE#3
- 27590 GOSUB 29730:GOSUB 29140:GOTO 27310
- 28460 Q=6:GOSUB 28810
- 28470 K=1:IF ESC OR L<=0 THEN RETURN
- 28480 IF LEFT$(W$,1)<>"-" AND LEFT$(W$,1)<>"+" THEN 28510
- 28490 K=2:IF K>L THEN 28680
- 28510 IF MID$(W$,K,1)="." THEN 28540
- 28520 IF MID$(W$,K,1)<"0" OR MID$(W$,K,1)>"9" THEN 28680
- 28530 K=K+1:IF K<=L THEN 28510 ELSE 28630
- 28540 K=K+1:IF K>L THEN 28680
- 28550 IF MID$(W$,K,1)<"0" OR MID$(W$,K,1)>"9" THEN 28680
- 28560 K=K+1:IF K<=L THEN 28550
- 28630 W!=VAL(LEFT$(W$,L))
- 28640 IF R=0 AND INT(W!)<>W! THEN 28670
- 28650 IF W!>=WL! AND W!<=WH! THEN RETURN
- 28660 LOCATE 25,1:COLOR 23,0:PRINT"Too big or too small";:GOTO 28690
- 28670 LOCATE 25,1:COLOR 23,0:PRINT"Whole number only";:GOTO 28690
- 28680 LOCATE 25,1:COLOR 23,0:PRINT"Improper numeric entry";
- 28690 COLOR 7,0:BEEP:OK=0:GOSUB 28830:GOTO 28470
- 28810 H=CSRLIN:G=POS(0)+1:MID$(W$,1)=SPACE$(Q)
- 28820 COLOR 0,7:PRINT SPACE$(Q+2);:COLOR 7,0:P=1
- 28830 LOCATE H,G,1:GOSUB 29660:LOCATE H,G,0:IF ESC THEN L=-1:RETURN
- 28840 IF LEFT$(C$,1)=CHR$(13) THEN L=P-1:RETURN
- 28850 IF LEFT$(C$,1)=CHR$(8) THEN 28940
- 28860 IF LEFT$(C$,1)=CHR$(32) THEN IF P>1 THEN 28910 ELSE 28980
- 28870 IF LEFT$(C$,1)<CHR$(32) THEN GOSUB 29830:GOTO 28830
- 28880 IF LEFT$(C$,1)>CHR$(127) THEN GOSUB 29830:GOTO 28830
- 28890 IF LEFT$(C$,1)>=CHR$(96) THEN MID$(C$,1,1)=CHR$(ASC(LEFT$(C$,1))-32)
- 28910 IF P>Q THEN GOSUB 29850:GOTO 28830
- 28920 MID$(W$,P,1)=LEFT$(C$,1):G=G+1:P=P+1
- 28930 COLOR 0,7:PRINT LEFT$(C$,1);:COLOR 7,0:GOTO 28830
- 28940 IF P<=1 THEN GOSUB 29850:GOTO 28830
- 28950 G=G-1:P=P-1:MID$(W$,P,1)=" "
- 28960 LOCATE H,G:COLOR 0,7:PRINT" ";:COLOR 7,0:GOTO 28830
- 28980 LOCATE 25,1:COLOR 23,0:PRINT"First character cannot be a space.";
- 28990 COLOR 7,0:BEEP:OK=0:GOTO 28830
- 29040 LOCATE 22,1:PRINT SPACE$(80);:IF MID$(D$,12,1)=" " THEN 29180
- 29050 PRINT"Insert the correct PROGRAM diskette";:GOTO 29190
- 29140 LOCATE 22,1:PRINT SPACE$(80);:IF MID$(D$,12,1)=" " THEN 29180
- 29150 PRINT"Insert the correct DATA diskette";
- 29160 IF MID$(D$,12,1)<"A" THEN 29190
- 29170 PRINT " in drive ";MID$(D$,12,1);" and close the door.";:GOTO 29230
- 29180 PRINT"Make sure the correct diskette is";
- 29190 PRINT" in the system drive and close the door.";
- 29230 LOCATE 24,1:BEEP
- 29240 PRINT"Press ENTER or Esc to continue.";
- 29250 H=CSRLIN:G=POS(0)
- 29260 LOCATE H,G,1:GOSUB 29650
- 29270 IF ESC OR LEFT$(C$,1)=CHR$(13) THEN 29290
- 29280 GOSUB 29830:GOTO 29260
- 29290 H1=23:H2=24:G1=1:G2=80:GOSUB 29740:RETURN
- 29550 PRINT" (Y=Yes, N=No)? ";:H=CSRLIN:G=POS(0)
- 29560 LOCATE H,G,1:GOSUB 29650:LOCATE H,G:IF ESC THEN RETURN
- 29570 IF LEFT$(C$,1)="n" OR LEFT$(C$,1)="N" THEN PRINT"N";:YES=0:RETURN
- 29580 IF LEFT$(C$,1)="y" OR LEFT$(C$,1)="Y" THEN PRINT"Y";:YES=-1:RETURN
- 29590 GOSUB 29830:GOTO 29560
- 29650 MID$(C$,1)=Z$:MID$(C$,1)=INKEY$:IF C$<>Z$ THEN 29650
- 29660 MID$(C$,1)=Z$:MID$(C$,1)=INKEY$:IF C$=Z$ THEN 29660
- 29670 ESC=0:IF LEFT$(C$,1)=CHR$(27) THEN ESC=-1
- 29680 LOCATE ,,0:IF OK THEN RETURN
- 29690 LOCATE 25,1:PRINT SPACE$(36);:OK=-1:RETURN
- 29730 H1=21:H2=24:G1=1:G2=80
- 29740 DEF SEG:AD=VARPTR(BS(1)):CALL AD(H1,G1,H2,G2):RETURN
- 29830 LOCATE 25,1:COLOR 23,0:PRINT"Wrong key pressed, try again.";
- 29840 COLOR 7,0:OK=0:BEEP:RETURN
- 29850 LOCATE 25,1:COLOR 23,0:PRINT"Can't move any farther.";
- 29860 COLOR 7,0:OK=0:BEEP:RETURN
- 29870 LOCATE 25,1:COLOR 23,0:PRINT"Data must be entered.";
- 29880 COLOR 7,0:OK=0:BEEP:RETURN
- 29910 LOCATE 25,1:COLOR 23,0:PRINT"Function not available.";
- 29920 COLOR 7,0:OK=0:BEEP:RETURN
- 29930 LOCATE 19,1,0:PRINT SPACE$(80);
- 29940 PRINT"PROGRAM ABORTED DUE TO A FATAL ERROR. F";
- 29950 PRINT"urther explanation of the following ";
- 29960 PRINT"error message may be found in Appendix A";
- 29970 PRINT" of the IBM or Compaq BASIC manual. ";
- 29980 PRINT SPACE$(239);:LOCATE 22,1,1:BEEP:ON ERROR GOTO 0
- 29990 END
-